/*rx
    $VER: $Id: MakeIndex.mm,v 1.9 1994/06/20 01:08:21 tf Exp $

    This script is ment to create a local Aminet mirror index.
    In general it creates a list of all files available in a given
    path including file size and file comment.

    Due to a problem with pragma('D') you *MUST* execute this script
    using RX explicitly -- even in the WShell.

    This ARexx script needs the AmigaDOS commands "List" and "Sort"
    available in your path.

    Initial revision by Tobias Ferber, 21-Feb-94
*/

options results
options failat 21


/* initialize globals */

headerline = "Index file as of" date('n')',' time('n')
indexfile  = ""   /* the one which we are about to create */
withfile   = ""   /* list of dirs and files to include or exclude */
pathname   = ""   /* the top directory of the tree to be scanned in order to create the index file */
tempfile   = "T:MakeIndexTemp." || pragma('Id')
temphide   = "T:MakeIndexTempHide." || pragma('Id')
lformat    = '%p' || '09'x || '%n' || '09'x || '%l' || '09'x || '%c'
template   = "FROM/K/A,TO/K/A,WITH/K,HIDE/S,AUTO/S"
hidestr    = ""
args       = ""
cliopts    = ""

dg       = 0  /* gauge increment */
gstepN   = 0

ESC      = '1b'x

signal on HALT
signal on BREAK_C
signal on BREAK_D


/* parse args */

do ac=1 while ac <= arg()
  av= arg(ac)
  select
    when upper(av) = "FROM" then do
      if ac < arg() then do
        ac= ac+1
        pathname= arg(ac)
        if words(pathname) < 1 then pathname= pragma('D')
        end
      else exit bad_args('Missing pathname after' ESC'bFROM'ESC'n keyword.')
      end /* FROM */

    when upper(av) = "TO" then do
      if ac < arg() then do
        ac= ac+1
        indexfile= arg(ac)
        end
      else exit bad_args('Missing index filename after' ESC'bTO'ESC'n keyword.')
      end /* TO */

    when upper(av) = "WITH" then do
      if ac < arg() then do
        ac= ac+1
        withfile= arg(ac)
        end
      else exit bad_args('Missing filename after' ESC'bWITH'ESC'n keyword.')
      end /* WITH */

    when upper(av) = "HIDE" then cliopts= cliopts || 'h'
    when upper(av) = "AUTO" then cliopts= cliopts || 'a'

    otherwise exit bad_args('Unknown keyword:' ESC'b' || av || ESC'n')

    end /* select */

  end /* do */

call pragma('W','N')


/* eventually try to get missing with file */

if pos('h',cliopts) > 0 then do
  if words(withfile) < 1 then do
    cwd= strip(pragma('D'),'B','"')
    REQUESTFILE DRAWER '"'cwd'"' TITLE '"Hide files listed in..."' NOICONS
    if (rc=0) & (words(result) > 0) & (result ~= 'RESULT') then withfile= result
    end

  if words(withfile) < 1 then
    exit bad_args("Not enough arguments for MakeIndex...*nExiting...")

  end

if (words(withfile) > 0) & ~exists(withfile) then do
  REQUESTCHOICE TITLE   '"MakeIndex Request"',
                BODY    '"MakeIndex failed to locate your WITH file*n*n' ||,
                        ESC'c'ESC'b' || withfile || ESC'n'ESC'l'         || '"',
                GADGETS '"Exit"'
  exit 10
  end


/* try to get missing index file */

if words(indexfile) < 1 then do
  cwd= strip(pragma('D'),'B','"')
  REQUESTFILE DRAWER '"'cwd'"' TITLE '"Write index to file..."' NOICONS SAVEMODE
  if (rc=0) & (words(result) > 0) & (result ~= 'RESULT') then indexfile= result
  end

if words(indexfile) < 1 then
  exit bad_args("Not enough arguments for MakeIndex...*nExiting...")


if exists(indexfile) then do
  REQUESTCHOICE TITLE   '"MakeIndex Request"',
                BODY    '"Index file*n*n'                              ||,
                        ESC'c'ESC'b' || indexfile || ESC'n'ESC'l*n*n'  ||,
                        'already exists.  Shall I replace it?'         || '"',
                GADGETS '"**_Yes|_No"'

  if result = 0 then do
    REQUESTCHOICE TITLE '"MakeIndex Request"' BODY '"MakeIndex canceled"' GADGETS '"Exit"'
    exit
    end
  end


/* try to get missing from path */

if ( words(pathname) < 1 ) then do
  cwd= strip(pragma('D'),'B','"')
  REQUESTFILE DRAWER '"'cwd'"' TITLE '"Select a directory..."' DRAWERSONLY NOICONS
  if (rc=0) & (words(result) > 0) & (result ~= 'RESULT') then pathname= result
  end

if words(pathname) < 1 then
  exit bad_args("Not enough arguments for MakeIndex...  Exiting...")

if pathname = '.' then pathname= pragma('D') /* current directory */

if ~exists(pathname) then do
  REQUESTCHOICE TITLE   '"MakeIndex Request"',
                BODY    '"MakeIndex failed to locate your directory*n*n' ||,
                        ESC'c'ESC'b' || pathname || ESC'n'ESC'l'         || '"',
                GADGETS '"Exit"'
  exit 10
  end


signal on ERROR
signal on IOERR

signal on FAILURE
/*signal on NOVALUE*/
signal on SYNTAX


/* do the hard part */


MESSAGE CLEAR; MESSAGE OPEN; COMPLETE 0
WORKING '"Pass 1"'

if pos('h',cliopts) > 0 then do
  err= listfiles(withfile,temphide)
  if err > 0 then exit 10

  COMPLETE 25

  if filesize(temphide) ~= 0 then do
    MESSAGE transquote('Sorting list of files to hide ...')
    address command 'Sort FROM "' || temphide || '" TO "' || temphide || '"'

    COMPLETE 30

    if ~open('hp',temphide,'R') then do
      MESSAGE transquote('Warning: Failed to open "'temphide'"... no files will be hidden')
      cliopts= compress(cliopts,'h')
      end
    else do
      do until eof('hp') | ( (words(hidestr) > 0) & (left(hidestr,1) ~= ':') )
        hidestr= strip( readln('hp') )
        end
      if eof('hp') then do
        call close('hp')
        cliopts= compress(cliopts,'h')
        withfile= ""
        end
      end
    end

  else do
    MESSAGE transquote('No files to hide ...')
    COMPLETE 30
    cliopts= compress(cliopts,'h')
    end

  end /* hide */

COMPLETE 50
MESSAGE transquote('Generating temporary index' tempfile 'from' pathname '...')

if (pos('h',cliopts) < 1) & (words(withfile) > 0) then do
  err= listfiles(withfile,tempfile)
  if err > 0 then exit 10
  end

else do
  cwd= pragma('D',pathname)
  address command 'List ALL FILES LFORMAT "' || lformat || '" NOHEAD TO "' || tempfile || '"'
  call pragma('D',cwd)
  end

COMPLETE 75

if filesize(tempfile) ~= 0 then do
  MESSAGE '"Sorting temporary index file ..."'
  address command 'Sort FROM "' || tempfile || '" TO "' || tempfile || '"'

  COMPLETE 100
  CALL init_gauge(tempfile,1)
  WORKING '"Pass 2"'

  MESSAGE '"Generating' indexfile 'from' tempfile '..."'
  if open('in',tempfile,'R') then do
    if open('out',indexfile,'W') then do

      call writeln('out','|'headerline'0a'x'|')
      call writeln('out','|File                Dir        Size Description')
      call writeln('out','|'copies('-',80))

      do while ~eof('in')
        CALL step_gauge(1)
        str= strip( readln('in') )
        if words(str) > 0 then do

          if (pos('h',cliopts) > 0) & (upper(str) = upper(hidestr)) then do
            last_hidestr= hidestr; hidestr= ""
            do until eof('hp') | ( (words(hidestr) > 0) & (left(hidestr,1) ~= ':') & (upper(hidestr) ~= upper(last_hidestr)) )
              hidestr= strip( readln('hp') )
              end

            if eof('hp') then do
              call close('hp')
              cliopts= compress(cliopts,'h')
              end
            end

          else do
            parse var str pname '09'x fname '09'x fsize '09'x fnote

            pname= strip(pname,B,' ' || '09'x)
            fname= strip(fname,B,' ' || '09'x)
            fsize= strip(fsize,B,' ' || '09'x)
            fnote= strip(fnote,B,' ' || '09'x)

            if right(pname,1) = '/' then pname = left(pname,length(pname)-1)
            if pname = "" then pname = '.'

            call writeln('out', left(fname,20,' ') || ' ' ||,
                                left(pname,10,' ') || ' ' ||,
                                bkmg(fsize)        || ' ' ||,
                                fnote)
            end

          end /* non-empty line */

        end /* do */

      call close('out')
      end

    else  REQUESTCHOICE TITLE   '"MakeIndex Request"',
                        BODY    '"Could not write to index file*n*n'      ||,
                                ESC'c'ESC'b' || indexfile || ESC'n'ESC'l' || '"',
                        GADGETS '"Exit"'
    call close('in')
    end

  else  REQUESTCHOICE TITLE   '"MakeIndex Request"',
                      BODY    '"Could not re-open temporary index file*n*n'  ||,
                              ESC'c'ESC'b' || tempfile || ESC'n'ESC'l'       || '"',
                      GADGETS '"Exit"'
  end

else  REQUESTCHOICE TITLE   '"MakeIndex Request"',
                    BODY    '"No files found in*n*n'                 ||,
                            ESC'c'ESC'b' || pathname || ESC'n'ESC'l' || '"',
                    GADGETS '"Exit"'

MESSAGE '"Deleting temporary files ..."'
address command 'Delete QUIET FILE "' || tempfile || '"'

if pos('h',cliopts) > 0 then do
  call close('hp')
  address command 'Delete QUIET FILE "' || temphide || '"'
  end

COMPLETE 100
MESSAGE '"done."'
IF POS('a',cliopts) > 0 THEN MESSAGE CLOSE
exit 0


bad_args: PROCEDURE EXPOSE template ESC
  PARSE ARG msg

  REQUESTCHOICE TITLE   '"MakeIndex Request"',
                BODY    '"' || msg || '*n*n'                     ||,
                        'MakeIndex args template:*n*n'           ||,
                        ESC'c'ESC'b' || template || ESC'n'ESC'l' || '"',
                GADGETS '"Okay"'
  RETURN 0


/* compute the size in KBytes, MBytes or GBytes respectively */

bkmg: procedure
  arg n
  do p=1 while n >= 2**10
    n = n / 2**10
    end
  n= compress(left(n,3,' '),' ')
  if right(n,1) = '.' then n= compress(n,'.')
  return right(n,3,' ') || substr('BKMG',p,1)


/* return the size of a file or '-1' if rexxsupport.library was not available */

filesize: procedure
  parse arg fname

  lib= show('L',"rexxsupport.library")
  if ~lib then lib= addlib("rexxsupport.library",0,-30,0)

  if lib then do
    fsize= value( word(statef(fname),2) )
    call remlib("rexxsupport.library")
    end
  else do
    fsize= -1
    MESSAGE '"Warning: rexxsupport.library not available; this may cause further problems ..."'
    REQUESTCHOICE TITLE   '"MakeIndex Request"',
                  BODY    '"'ESC'c'ESC'brexxsupport.library'ESC'n'ESC'l*n*n'    ||,
                          'not available;  this may cause further problems ...' || '"',
                  GADGETS '"Continue"'
    end

  return fsize


/* generate a file list */

listfiles: procedure expose lformat pathname ESC
  parse arg infile,outfile
  err = 0

  if exists(outfile) then
    address command 'Delete QUIET FILE' '"'outfile'"'

  /* create output file (maybe NOCLOBBER is set...) */
  if open('fp',outfile,'W') then do
    call close('fp')

    /* Expand the input file */
    if open('fp',infile,'R') then do
      MESSAGE transquote('Expanding file' infile 'to' outfile '...')
      do until eof('fp')
        str= strip( readln('fp') )
        if (words(str) > 0) & (left(str,1) ~= '#') then do
          cwd= pragma('D',pathname)
          signal off ERROR
          address command 'List LFORMAT "' || lformat || '" >>' '"'outfile'"' str
          signal on ERROR
          call pragma('D',cwd)
          end
        end
      call close('fp')
      end
    else do
      REQUESTCHOICE TITLE   '"MakeIndex Request"',
                    BODY    '"MakeIndex failed to open your file*n*n' ||,
                            ESC'c'ESC'b' || infile || ESC'n'ESC'l'    || '"',
                    GADGETS '"Exit"'
      err= 1
      end
    end
  else do
    REQUESTCHOICE TITLE   '"MakeIndex Request"',
                  BODY    '"MakeIndex could not write to*n*n'     ||,
                          ESC'c'ESC'b' || outfile || ESC'n'ESC'l' || '"',
                  GADGETS '"Exit"'
    err= 2
    end

  return err

/*@*/


/* translate '"' into '*"' and '*' into '**' */

transquote: procedure
  parse arg s
  t= s
  q= max( lastpos('*',s), lastpos('"',s) )
  do while q > 0
    t= insert('*',t,q-1,1)
    s= left(s,q-1)
    q= max( lastpos('*',s), lastpos('"',s) )
    end
  return '"' || t || '"'


/* return the non-file part of a pathname */

pathonly: procedure
  parse arg path
  if (words(path) > 0) & (right(path,1) ~= ':') then do
    if right(path,1) = '/' then path= left(path,length(path)-1)
    if lastpos('/',path) > lastpos(':',path) then path= left(path,lastpos('/',path)-1)
                                             else path= left(path,lastpos(':',path))
    end
  return path


/* return the file part of a pathname */

fileonly: procedure
  parse arg path
  if right(path,1) = '/' then path= left(path,length(path)-1)
  p= max( lastpos(':',path), lastpos('/',path) )
  if(p>0) then return substr(path,p+1)
          else return path


/* concatenate the filename to the pathname and return the resulting string */

tackon: procedure
  parse arg path,file
  do while left(file,1) = '/'
    file= substr(file,2)
    path= pathonly(path)
    end
  if (words(path) > 0) & (right(path,1) ~= '/') & (right(path,1) ~= ':') then path= path || '/'
  if (right(file,1) = '/') then file= left(file,length(file)-1)
  return path || file


/* create all non-existant directories in a path */

makepath: procedure
  parse arg path
  if right(path,1) = '/' then path= left(path,length(path)-1)
  if ~exists(path) then do
    call makepath( pathonly(path) )
    address command 'MakeDir NAME "'path'"'
    end
  return 0


/*
 * return   1  if the device or volume name in given pathname exists
 *             or if no device or volume was present (current device)
 *          0  if the device or volume name does not exist
 */

canexist: procedure
  parse upper arg path
  if pos(':',path) < 1 then return 1 /* current device */
  call pragma('W','N')
  return exists( left(path,lastpos(':',path)) )


/* stretch the blue completion bar */

step_gauge: PROCEDURE EXPOSE dg gstepN
  ARG increment
  gstepN= gstepN + 1
  c= MIN(TRUNC(gstepN * increment * dg),100)
  COMPLETE c
  IF c >= 100 THEN WORKING '"done."'
  RETURN 0


/* initialize the gauge increment by counting the #of steps to be performed */

init_gauge: PROCEDURE EXPOSE dg gstepN
  PARSE ARG fname,steps_per_entry

  dg = 0         /* gauge increment */
  gstepN = 0     /* #of performed steps */

  IF OPEN('fp',fname,'R') THEN DO
    numentries= 0
    DO UNTIL EOF('fp')
      IF WORDS(READLN('fp')) > 0 THEN
        numentries= numentries+1
      END
    MESSAGE '"Processing' numentries 'entries ..."'
    dg = 100 / (numentries * steps_per_entry)
    CALL SEEK('fp',0,'B')
    CALL CLOSE('fp')
    END

  /*MESSAGE CLEAR; MESSAGE OPEN*/
  COMPLETE 0
  RETURN 0


/* error/break handling */

IOERR:
ERROR:
  err= rc
  ESC = '1b'x

  signal off ERROR
  signal off IOERR

  WORKING '"I/O problem trapped... Execution halted."'
  MESSAGE '"I/O problem trapped... Execution halted."'

  REQUESTCHOICE TITLE   '"MakeIndex Error Trap' err'"',
                BODY    '"There was a problem with external I/O in line' sigl '...*n' ||,
                        ESC'c'ESC'b' || ERRORTEXT(err) || ESC'n'ESC'l'                || '"',
                GADGETS '"I''ll better exit"'
  exit


FAILURE:
NOVALUE:
SYNTAX:
  err= rc
  ESC = '1b'x

  signal off FAILURE
  signal off NOVALUE
  signal off SYNTAX

  WORKING '"Internal problem trapped... Execution halted."'
  MESSAGE '"Internal problem trapped... Execution halted."'

  REQUESTCHOICE TITLE   '"MakeIndex Internal Error' err'"',
                BODY    '"MakeIndex seems to have an internal problem in line' sigl '...*n' ||,
                        ESC'c'ESC'b' || ERRORTEXT(err) || ESC'n'ESC'l'                      || '"',
                GADGETS '"I''ll better exit"'
  exit


HALT:
BREAK_C:
BREAK_D:
  signal off HALT
  signal off BREAK_C
  signal off BREAK_D

  WORKING '"Break signal trapped... Execution halted."'
  MESSAGE '"Break signal trapped... Execution halted."'

  REQUESTCHOICE TITLE   '"MakeIndex Break Trap"',
                BODY    '"Script execution halted."',
                GADGETS '"Stop"'
  exit
